38888 
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**F ILE**1D**COBF INDNA 

cccccccc 000000 BBS88BB8B FFFFFFFFFF IIIIII NN NN DDDDDDDD NN NN AAAAAA 
cccccccc 000000 BBB88B8BB FFFFFFFFFF IIIII1 NN NN DDDDDDDD NN NN AAAAAA 

cc 00 00 88 BB OFF II NN NN DD DD NN NN AA aa 

cc 00 00 8B BB OFF Il NN NN DD DD NN N AA AA 

cc 00 00 88 BB OFF II NNNN NN DD DD NNNN NN AA aA 

cc 00 00 88 FF Il NNNN NN DD DD NNNN NN AA AA 

cc 00 00 88888888 FFFFFFFF Il NN NN NN DD DD NN NN NN AA AA 

cc 00 FFFFFFFF Il NN NN NN DD DD NN NN NN AA Aa 

cc 00 00 8B BB OFF I! NN NNNN DD DD NN NNNN AAAAAAAAAA 

cc 00 0O BB BB OFF Il NN NNNN DD DD NN NNNN AAAAAAAAAA 

cc 00 00 8B BB OFF II NN NN DD DD NN NN AA aA cece 

cc 00 00 68 BB OFF Il NN NN DD DD NN NN AA Lal eves 
cccccccc 000000 BBBBBBBB FF I1III1 NN NN DDDDDDDD NN NN AA Aa cove 
cccccccc 000000 BBBBBBBB FF III NN NN DDDDDDDD NN NN AA AL eeee 

LL III] SSSSSSSS 

LL III] SSSSSSSS 

LL I] SS 

LL I] SS 

LL I] SS 

LL I] SS 

LL I] SSSSSS 

LL I] SSSSSS 

LL I] S$ 

LL I] SS 

LL I] SS 

LL I] SS 

LLLLLLLLLL III] SSSSSSSS 

LLLLLLLLLL III] SSSSSSSS 


F 16 | 
COBSF IND _NAME 16Sep-1984 00:08:22  VAX=11 Bliss-32 v4.0-7% ° ' 
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ee 001 0 MODULE COBSFIND_NAME ( 

5 ¢ pDENT = '1-013' ' file: COBFINDNA.B32 EDIT:LB81013 

b+ = 

3 4 004 1 BEGIN 

; 2 Beo2 : ; 

: 7 00 1 i weeeeererereeeereneeeeeeenedeteeeeereereereeeeeeeeenenenereeeeeeeeeeeeeeees 
3 8 5008 1 te * 
; 9 444 1 !® COPYRIGHT (c) 1978, 1980, 1982, 1984 BY * 
> 10 0010 1 i* DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. . 
; ip pet3 : ;* ALL RIGHTS RESERVED. * 
© . ® 
; ig oO18 1 !* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * 
; % 0014 1 !* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * 
F4 15 SF 1 !* INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * 
5 16 We 1 !® COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ® 
3 17 001 1 !* QTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
3 3 Bats ! . TRANSFERRED. * 
3 '® * 
3 20 0020 1 !* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE x 
3 1 0021 1 !* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * 
; ¢ $08 ! re CORPORATION. * 
3 i® ® 
; $¢ 0094 1 !* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS * 
; 5 025 1 !* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. * 
a 0037 1 is : 
: 2B pees 1 i eeeeeeeeeeeeeeeeeeneeeeeeeneeeeeeeeeeeeeeedeeedereneeneneeneeeeereeeeeeeee 
; 9 029 1! 

: $0 $034 i = 

: 32 005¢ i FACILITY: COBOL SUPPORT 

; 34 0034 1 | ABSTRACT: This procedure wiil search Lists of program names for 

.. a 0035 1! a routine name match to the name found in the input 

3 36 0036 1! parameter ‘'DESC"’. 

te oer 1! 

; $ 039 i 

: 40 040 1 | ENVIRONMENT: Vax-11 User Mode 

; r Bees ’ } NOTE this module cannot be in sharable Library. 

; <8 Doe§ : AUTHOR: M.L.Jack , CREATION DATE: 29-JUL-1979 

; 45 0045 ' MODIFIED BY: 

: 47 0047 1 | 1-001 = Original. MLJ 29-JUL-1979 

: 48 8 1 ! 1-002 = Added boilerplate and comments. RKR 18-JULY-1979 

; | (49 049 1 ! 1-005 = Make LIBRARY ge REQUIRE file compatible with rest of system. 

s $0 050 1! RKR 19-SEPT-7 

; th 1 ! 1-004 = Rewrite name string analyis to catch leading space case. 

3 2g 0 ; 3 Current logic will return status of zero if any of the 

oe 055 1! following occur: ; 

3 54 054 1! a Leading spaces or tabs ore present in the string 

2: oe Boee ': - Result 99 string with trailing spaces or tabs 

3 2$ 28 1! exceed 30 chars. 

ae 0957 1! - Resulting string cannot be found in table 


16 
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Imbedded spaces or tabs stop the scan the same way trailing 
Apaces end, seee do, and will probably yield look-up failure 


1-005 = Revise algorithm to staply throw oyay leading spaces and tabs 
and continue tgenning. RKR 3-0CT-79 
1-006 - piso, ley af * 10 2C°9" as legal chars in name. (Oversight) 
1-007 = Accomodate oew structure for module name data table. 
RKR 19-0CT-7 
1-008 - Change name grtraceton logic to behave Like GENEXTERN.B32 
RKR 19-0CT-7 


09 = Add error for Syppect tees ty invalid name. RKR 21-OCT-79 

10 = Remove all signalling. RKR 29-0CT-79 

11 = Remove definition of OBJSC_SYMSIZ. SBL 5-Dec-1979 

12 = Introduce a new gt LOCAL_SYMSIZ to replace role of | 
former symbol OBJSC_SYMSIZ. At sometime when the Libraries 
are universally straightened out we can switch back to 
OBJSC_SYMSIZ and allow it to be defined via Library. 
ey the way, its value should be 31) 
RKR 06-DEC=79 


1-013 = Added abstract, functional description, comments and made 
cosmetic changes. Changed hardcoded codes for tabs and 
blanks into Literals to enhance readability. Also added 
code that checks to make sure that if a second input 
parameter exists, that it is non-zero. Changed code that 
spever tes eee characters to uppercase characters. 


a 1 
oO 1 
° 1 
o 1 
; 1 
; 1 
; 1 
1 
; 1 
a 1 
o 1 
; 1 
9 1 
3 1 
qe 0072 1 
° 1 
o 1 
; 1 
e 1 
3 1 
3 1 
3 1 
eo 1 
; 1 
; 1 
3 1 
; 1 
3 1 
3 1 
: 1 
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; oes 1 !¢ 

; 089 1 ! SWITCHES 

2 Be 

3 38 O36 ' SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 
; 0946 1 !+ 

; 96 095 1 ! LINKAGES 

s 97 Bos 1! NONE 

; «98 097 1 !- 

; 299 0098 1 

: 100 099 1 !4 

: 101 130 1 ! TABLE OF CONTENTS: 

3 136 101 1 !- 

; 10 8108 1 

: 104 10 1 FORWARD ROUTINE 

3; 105 104 1 

: 106 105 1 COBSSFIND_NAME ; 

: 107 0106 1 

; 108 0107 1 !+ 

3 109 0108 1 ! INCLUDE FILES 

3; 110 0109 1 !- 

wee 0110 1 

3 ig 0111 1 LIBRARY 'RTLSTARLE'; ! Contains all RTL routines : 
3 at gilé : REQUIRE 'RTLIN: COBDEF'; ! COBOL specific RTL macros and Literals 
s 115 0555 1 i+ 

; 116 0556 1 ! MACROS 

3 117 0557 1! NONE 

s 118 0558 1 !- 

3; (119 0559 +1 

: 120 0560 1 !+ 

3: 121 0561 1 ! EQUATED SYMBOLS 

; \¢¢ b26¢ 1 !- 

SSE 05635 1 

: 126 0564 1 LITERAL 

2° S25 0565 1 TRUE = 1 

3 126 0566 1 FALSE = 6 

> 127 0567 1 TAB = Z0'{1° ! TAB character 

: 128 0568 1 BLANK = 20°46", ! BLANK character 

3 4 0569 1 LOCAL_SYMSIZ = 31 ; ! When Libraries get consistent on 

: 130 0570 1 ' various development machines, this 

3: 6131 0571 +1 ! definition should be removed and 

3 13 6276 1 ! the corresanding references in the 

= 573 1 ' code should be to the Library-defined 
3 «134 0574 1 ! symbol OBJSC_SYMSIZ 

s 155 0575 «1 

s 136 276 1 !¢ 

3 137 57 1 ! PSECT DECLARATIONS: 

s 138 578 1 !- 

3; 139 579 1 

3: 140 580 1 PSECT 

: 161 581 1 GLOBAL= COBSNAMES_____1(PIC, SHARE ,NOWRITE ,ADDRESSING_MODE(LONG_RELATIVE)); 
; 166 286 1 GLOBAL 

: 16 583 1 COB$GZ_NAMES_1: VECTOR(O); 

3 1446 bene 1 PSECT 

3; «6145 585 1 GLOBAL= COBSNAMES 3(PIC, SHARE ,NOWRITE ,ADDRESSING_MODE(LONG_RELATIVE)); 
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CODE (PIC,SHARE), 
CODE; 


cobs 
Coss 


-o 
—Ar 
wo 


SERRRSRRSSERES 


oO 
WAIWAIAI WII POPONONPUNIPOPU NON — 


total total ttt stata 
MEWN —OODNOUESWN $OVOVNOUS WN O 


io 
o 


eer 


SELESEANLSESSLSEALEAT ELS SSIS ARAN ASSSLSALATLSSSLEARF 
PIPIPIMPIPIMINDAININININ IPI IIIN IAN a a a tt a kd dd 


SSS 
FSSSSSSSTS. 


OWONAOULSWN—OO 


PIP IM NINIHIPDNIN NIN es an st tt at a kk dh dh ht th to 


Be Se Se Se Se Se Se Ge Ge Fe Se Se Ge Be Se Ge Ge Ge Ge Ge Ge Ge Ge Ge Fe Ge Ge Ge Se Se Se Se Se Ge Se oe Se Ge Se Ss Se Se Se Se Se oe Se Se Ge Se Se SH Se Se Ss Se ee 


SSSVERE 


e 


J 
VenSepm1986 19:10:66 


GLOBAL ROUTINE COBSSFIND_NAME (DESC,LLIST)= 


Soe 


FUNCTIONAL DESCRIPTION: 


the COBSNAMES entry; otherwise, 
CALLING SEQUENCE: 


FORMAL PARAMETERS: 
DESC.rt.ds 
LLIST.rr.r 

IMPLICIT INPUTS: 
NONE 

IMPLICIT OUTPUTS: 
NONE 

ROUTINE VALUE: 


SIDE EFFECTS: 


NONE 
BEGIN 

MAP 
DESC: REF BLOCKC,BYTE), 
LLIST: REF VECTOR; 

BUILTIN 
ACTUALCOUNT, 
ACTUALPARAME TER; 


LOCAL 
BUFFER: VECTORCLOCAL_SYMS1Z,BYTE), 
NAMELENGTH 
NAMEPOINTER: REF VECTORC, BYTE), 


COBSSFIND_NAME (desc.rt.ds, Llist.rr.r) 


AX-11 Oi regen eee a 
COBRTL.SRCJCOBF INONA.B52;1 


This routine will search through the list of local groaram names 
to find a match to the name that is passed in the ‘DESC"’ 
input parameter. If no match is found, 5gug" 
the List of global program names (designated by the COBSGZ_NAMES_2 
structure). If a match is a. 


it searches th 


then it returns a pointer to 
returns a value of zero. 


Address of descriptor of name string 
Pointer to counted List of accessible names 


Pointer to COBSNAMES entry, or 0 if not found 


' Pointer to descriptor for name string 
! Pointer to counted List of local programs 


'\Returns # of actual parameters 
'/passed to this routine 

'\Returns the value of the i'th 
'/actual parameter that was passed 


' Buffer for input name 

' Length of input name 

' Pointer to input name 

! Offset of first nonblank 


16 
= meee 1e=$ep-1986 12:10:66 — LedaRtLeSReScOBr INNA-BS2; 1 oe 
' 
i 
| 


> 211 0 P: REF BLOCK C,BYTEJ, Pointer for seoching 

3 i 1 L. Length of finished literal 

; \? ¢ Q: REF VECTORC,BYTE); Pointer to ASCIC name string 
: 215 4 NAMELENGTH = .DESCCDSC$W_LENGTH); ' Length of input name 

; 1$ 5 NAMEPOINTER = .DESCCDSCSA_POINTER]; ! Pointer to input name 

: 18 €9 

- ae 658 

3 0 59 

3 ; Ose} L = 0; ! Init length of finished Literal 
: 4 06e$ + 

3 5 ! Strip trailing blanks and tabs. 

: : Ose? DECR I FROM .NAMELENGTH=1 TO 0 DO 

: $0 +444 IF .NAMEPOINTERC.1] NEQ BLANK AND .NAMEPOINTERCL.1] NEQ TAB 

; 3¢ 0671 4 BEGIN 

3 @3 Bere 4 L=.1+1; '\Length of name without 

> 234 0673 4 '/trailing blanks and spaces 

s e339 0074 4 EXITLOOP; ! Found a valid char - exit the loop 
3 “8 0675 3 END; 

3; 2 0676 END; 

oe 

; 366 0679 IF .L EQL 0 

: ak eed $ : RETURN 0 ! Invalid parameter - no input name 
; Sta boas BEGIN 

ie Oe . 

+ 267 0686 3 i Strip leading spaces and tabs. 

; 248 0687 !- 

: $35 0689 A=0 

> 251 0690 WHILE .NAMEPOINTERL.A] EQL BLANK OR .NAMEPOINTERL.A) EQL TAB DO 

: $26 0691 4 BEGIN 

; @ 0692 4 L=.kb- 1; '\Decr name Length for every 

> 254 368 4 ‘/occurrence of blanks or tabs 
; 23 94 4 A= A?+1; ! Advance the index 

3 2$ 904 ND; 

thea: . 

3 260 99 i Ensure that the result, with leading and trailing spaces 

: 261 700 ! removed, is not too long. 

; o¢ 701 te 

3; 2 4 

3 3 704 IF_.L GTR LOCAL_SYMSIZ 

: 266 705 RETURN 0 ; ! Invalid symbol name 

3; 267 706 
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'¢ 
! Now convert and check the characters for legality in the 

! object Lenpuese. The valid characters for COBOL string names 

! include al percase characters, 0-9, dollar sign ($) and 
underscore (_). Note that all lowercase characters are converted 
! 

! 


OOo 


NOUS WN —OCONOUES WOOO 


to uppercase and that hyphens are converted to the underscore 
character. 


INCR I FROM 0 TO .L=1 DO 
BEGIN 


LOCAL 
C;: 


C = .NAMEPOINTERCL.1+.A]; 
ive -C OF 


PNIPIPIPORINT — 


SNS SSS SSS SSS 


a ‘ ! Convert hyphen to underscore 
— 
3 CxC‘a’ To-%e*2"): Convert lowercase to uppercase 
Ps cxeea' fo wee ! Just substract 20°40" to get uppercase 
1 ZC°O* TO %C'9', 
¢ S's mM at 
; ! Characters are valid - do nothing 


COTHERWISE): ! Error - invalid characters 
RETURN O ; 


NN 
ou 


WALI PORSPUPUPOPPUPUNIIUNIIVINWE FERRE EER EERE R EERE EERE EEE PUA 


96 
97 


Py 
lee 


' Complete name is copied into ‘BUFFER’ 
! one character at a time. 


BUFFERC.1) = .C 
END; 
END; 


+ 
If resultant string exists, try looking it up. 


' 

i 

i 

! If there is more than 1 input parameter and the second parameter 
! is non-zero, then search through the List of local programs. 

! Otherwise, try the list of global programs. Note that when 
goerching through the List of local programs and a match is not 
! found, the 

programs. 


default is to search through the List of global 


IF (ACTUALCOUNT() GTR 1) AND (ACTUALPARAMETER (ACTUALCOUNT()) NEQ 0) 
INCR See 1 TO .LLISTCO) DO 


P=, beste 1 ! Fetch addr of name entry block , 
Q = .PCCOBSA_NAM_NAME]; ! Fetch Ist byte of counted name string 


NNN NNN 
PO AA ON IN 
SOONO AE WOOD NOUE WN =O OOS 
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IND _NAME AX=11 Bliss-32 V4.0-76 p 4 
it 1e-gee 138s 93:98:28 = eter hs scoee naa eSe-1 a 
} 5 764 ; IF .QCOJ EQL .L ! If length matches 

: 358 tee MME GIN 

; ; ref 2 IF CHSEGL (.L,QC1], .L, BUFFER) ! If string matches 

; , q 2 oe .P ! Return addr of this name entry block 

; 4 771 & ! No match occurred 

3 a we END; 

; 335 tt? : 

3 775 '¢ 

3 re ' Now 2 ss sf 'botn programs. Note that 

3 77 i COBSG points to the beginning of th 

: 9 ore ; topsee “NAMES "2 structure while COBSGZ_NAMES_ 

3 ? f 3 points to the end of the structure. 

; : Ore 

: 07 P = COBSGZ_NAME ' Ist (if any) entr 

; 4 +e ween Sh Ebasci _NAMES_2 DO ' . 

; $ 0785 a CORSA. NAM_NAME) ; ! Ptr to Ist byte of counted name string 
; 0786 tr -QC0) EQL~.L ! If Length matches 

3 ; 4 TA ? THEN sin 

; 29 0789 ? IF CHSEQL (.L, QC1], .L, BUFFER ) ! If string matches 

: 3¢ 0791 4 eRe TURN .P ! Retn addr of this name entry block 

; rr O78 4 aa ! No match found 

; 356 0798 : P = .P + .PCCOBSL_NAM_LENT) ; ! Advance to next entry 

3 57 p76 END ; 

: 33 fad RETURN 0; 

; 0799 END ; ! End of routine COBSSFIND_NAME 


-TITLE couse = NAME 
IDENT = \1-013\ 


-PSECT COBSNAMES 


00000 COBSGZ_NAMES 2:: 
-BLKB 0 


-PSECT COBSNAMES 1,NOWRT,NOEXE, SHR, PIC,2 


00000 COBSGZ_NAMES_1:: 
-BLKB 0 


3,NOWRT,NOEXE, SHR, PIC,2 


-PSECT _COBSCODE.NOWRT, SHR, PIC,2 


00000 -ENTRY COgSSE IND MANE . Save R2,R3,R4,R5,R6,R7 : 0595 
SE 20 C2 00002 SUBL2 #52, SP 


1 


SF IND_N 
1-013 * ve 
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7) 
- « - <«£ 
ss sss 
g 8 sss 
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Routine Size: 264 bytes, 
361 0800 1 END 
362 0801 0 ELUDOM 

Name 
COBSNAMES_____ 1 
COBSNAMES 3 

COBSCODE 


File 
_$255$DUA28:(SYSLIBISTARLET 


bin: 


1 19 
1 p-19 
0 13 8 
8 be bo087 
5 pe aces Bb BBREE te 
SBR PCAB. BB Sag te 
08 00 FB 00C4 
97 § 0oCc9 
01 A7 4 . 00CB 
2A ; 00D0 
56 08 ec F Boos 17$: 
55 00000000' EF 9E O00D7 18$: 
50 00000000° EF a5 BROE 19$: 
50 5 D1 QO0OE 
18 if 0E8 
57 046 AS OD Bapee 
08 00 €D it 
0B ie OQOOF 
01 A7 54 29 000F5 
04 12 QOOFA 
50 55 DO OOOFC 20$: 
04 OOOFF 
55 65 CO 80100 21$: 
09 +11 Be8 
50 D4 00105 22$: 
04 00107 
Routine Base: _COBSCODE + 0000 
PSECT SUMMARY 
Bytes Attributes 
0 NOVEC,NOWRT, RD ,NOEXE, SHR, 
Q NOV EC;N NOWRT, RD ,NOEXE, 
264 NOVEC,NOWRT, RD, EXE, ° 
Library Statistics 
wen ene Symbols wane eee 
Total Loaded Percent 
-L32;1 9776 2 0 


4 00:08:2 AX-11 Blis 
Be 99:98:26 COBRTL’S Lee coor INDWA B82; 3} 
BEQL 18$ 
CLRL 
BRB 17$ 
MOVL @LLISTCIJ, P 
MOVL 4(P), Q 
CMPZV #0, #8, (Q), L 
BNEQ 
CMPC3 1(Q), BUFFER 
BEQL $ 
AOBLEQ aLLIST, I, | 
MOVAB COBS$GZ “NAMES_1 
mays COBSez_ NAMES w A RO 
re 
BGEQU 22$ 
MOVL 4(P), 
CMPZV #0 #8” L 
BNEQ 
CMPC3 1(Q), BUFFER 
BNEG © 31s 
MOVL P, RO 
RET 
ADDL2 (P), P 
BRB 19$ 
CLRL RO 
RET 
LCL, REL, CON, PIC,ALIGN(2) 
LCL, REL, CON, piece tonsss 
LCL, REL, CON, PIC,ALIGN(2) 
Pages Processing 
Mapped Time 
581 00:00.8 


aygne.se 


BLISS/CHECK=(FIELD, INITIAL OPTIMIZE) /NOTRACE/L1S=L1S$:COBF INDNA/OBJ=0BJ$: COBF INDNA MSRC$ : COBF INDNA/UPDATE=(ENH$ : COBF INDNA 


Run Time: 


Elapsed 
Lines/C 
ee 


eee Bl 


COMMAND QUALIFIERS 


264 code 4 0 data bytes 
ge: 05.9 


Time: 0:20.9 
PU Min: a F 4 
/CPUSMin: 22942 
Used: 119 pages 
tion Complete 
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